MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 05 - 1989/05.03 Mar 89/Basic⁄Pascal Source Code/ADB Pascal Sample/myADBStuff

Text File | 1989-02-07 | 13.6 KB | 525 lines | [TEXT/PJMM]

unit MyADBStuff;

interface

    uses
        OSIntf, PrintTraps, MyADBGlobals;

    procedure doMessage (message0: str255; message1: str255; message2: str255; message3: str255);
    procedure doAbout;
    procedure doQuit;
    procedure doMenubar (menuResult: LongInt);
    procedure doContent (ConEvent: EventRecord; contentWindow: windowPtr);
    procedure doDrag (GrabWindow: WindowPtr; GlobalMouse: point);
    procedure doGrow (ResizeWindow: WindowPtr; Globalmouse: point; Zoomflg: Boolean);

implementation

    procedure doMessage; {(message0 : str255}
                                    {message1 : str255}
                                    {message2 : str255}
                                    {message3 : str255)}
        var
            dialogP: DialogPtr;
            item: integer;
    begin
        ParamText(message0, message1, message2, message3);
        dialogP := GetNewDialog(MessageDialog, nil, pointer(-1));
        if dialogP = nil then
            begin
                SysBeep(5);
                ExitToShell;
            end;
        initCursor; {change to arrow}
        ModalDialog(nil, item);
        DisposDialog(dialogP);
    end;

    procedure delay;
        const
            stalltime = 15; {quarter seconds in ticks}
        var
            i: LongInt;
            tick1, tick2: LongInt;
    begin
        tick1 := TickCount;
        tick2 := tick1;
        repeat
            tick2 := TickCount;
        until tick2 >= tick1 + stalltime;
    end;

    procedure togglelightsoff;
        const
            flushcommandNum = $21;  { 00100001 }
    begin
        Buf.opServiceRtPtr := Info.dbServiceRtPtr;    {service routine pointer}
        Buf.opDataAreaPtr := Info.dbDataAreaAddr;   {optional data area address}
        OSEr := ADBOp(nil, nil, Buf.dataBuffPtr, flushcommandNum);  { Flush command, clears the device }
        if OSEr = -1 then
            doMessage('Unable to flush device', '', '', '');
    end;

    procedure togglelightson;
        var
            LEDaddress: ptr;
            LEDbyte: signedbyte;
        const
            talkcommandNum = $2E;  { 00101010 }
            listencommandNum = $2A; { 00101110 }
    begin
        if OSEr = noErr then
            begin
                Buf.opServiceRtPtr := Info.dbServiceRtPtr;    {service routine pointer}
                Buf.opDataAreaPtr := Info.dbDataAreaAddr;   {optional data area address}
                togglelightsoff;
                OSEr := ADBOp(Buf.opDataAreaPtr, Buf.opServiceRtPtr, Buf.dataBuffPtr, talkcommandNum);
                if OSEr = -1 then
                    begin
                        doMessage('Unable to talk to device', '', '', '');
                        exit(togglelightson);
                    end;
                delay;
                LEDaddress := POINTER(ORD(Buf.dataBuffPtr) + 2);
                LEDbyte := LEDaddress^;
                if LEDbyte = -1 then
                    LEDaddress^ := -8; {turn on}
                OSEr := ADBOp(Buf.opDataAreaPtr, Buf.opServiceRtPtr, Buf.dataBuffPtr, listencommandNum);
                if OSEr = -1 then
                    begin
                        doMessage('Unable to listen to device', '', '', '');
                        exit(togglelightson);
                    end;
            end; {of noErr}
    end;

    procedure LightsMagic;
    begin
        togglelightson;
        delay;
        togglelightsoff;
        delay;
        togglelightson;
        delay;
        togglelightsoff;
        delay;
        togglelightson;
        delay;
        togglelightsoff;
        delay;
        togglelightson;
        delay;
        togglelightsoff;
        delay;
    end;

    procedure QuerySystem;
        var
            str1, str2: str255;
    begin
        NumToString(LongInt(theWorld.environsVersion), str2);
        str1 := concat('Environment Version = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

        case theWorld.machineType of
            0:
                str2 := 'new version of Macintosh';
            1:
                str2 := 'Macintosh 512K enhanced';
            2:
                str2 := 'Macintosh Plus';
            3:
                str2 := 'Macintosh SE';
            4:
                str2 := 'Macintosh II';
            otherwise
                begin
                    if theWorld.machineType = -1 then
                        str2 := 'Macintosh with 64K ROM';
                    if theWorld.machineType = -2 then
                        str2 := 'Macintosh XL';
                end;
        end; {of case}
        str1 := concat('Machine Type = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

        NumToString(LongInt(theWorld.systemVersion), str2);
        str1 := concat('System Version (must convert to hex) = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

        case theWorld.processor of
            0:
                str2 := 'new processor';
            1:
                str2 := 'MC68000 processor';
            2:
                str2 := 'MC68010 processor';
            3:
                str2 := 'MC68020 processor';
            4:
                str2 := 'MC68030 processor';
            otherwise
                begin
                    str2 := 'unknown processor';
                end;
        end; {of case}
        str1 := concat('Processor = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

        NumToString(LongInt(theWorld.hasFPU), str2);
        str1 := concat('Has Floating Point Coprocessor (1=Y) = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

        NumToString(LongInt(theWorld.hasColorQD), str2);
        str1 := concat('Has Color QuickDraw (1=Y) = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

        case theWorld.KeyBoardType of
            0:
                str2 := 'Macintosh Plus keyboard with keypad';
            1:
                str2 := 'Macintosh keyboard';
            2:
                str2 := 'Macintosh keyboard and keypad';
            3:
                str2 := 'Macintosh Plus keyboard';
            4:
                str2 := 'Apple extended keyboard';
            5:
                str2 := 'Standard Apple Desktop Bus keyboard';
            otherwise
                begin
                    str2 := 'Unknown keyboard value';
                end;
        end; {of case}
        str1 := concat('Keyboard Type = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

        NumToString(LongInt(theWorld.atDrvrVersNum), str2);
        str1 := concat('Appletalk Driver Version = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

        NumToString(LongInt(theWorld.sysVRefNum), str2);
        str1 := concat('Working Directory Volume Ref = ', str2, chr(13));
        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);
    end;

    procedure doADB;
        var
            devTableIndex: integer;
            str1: str255;
    begin
        TESetSelect(0, TEMax, MyTextHandle);
        TEDelete(MyTextHandle);
        ShowWindow(ADBWindow);

        OSEr := SysEnvirons(versRequested, theWorld);
        if OSEr = envNotPresent then
            doMessage('System File older than 4.1!', '', '', '');
        if OSEr = envBadVers then
            doMessage('Bad Version Requested', '', '', '');
        if OSEr = envVersTooBig then
            doMessage('Requested Version Not Available', '', '', '');
        if OSEr = noErr then
            begin {Query and Blinking routine}

                QuerySystem;

        {toggle keyboard lights on and off}
                if theWorld.keyBoardType = 4 then
                    begin {keyboard type 4}
                        str1 := concat(chr(13), 'Watch the keyboard lights blink…  ', chr(13));
                        TEInsert(pointer(ord4(@str1) + 1), Length(str1), MyTextHandle);

                        numberofADBs := CountADBs;
                        for devTableIndex := 1 to numberofADBs do
                            begin {devTableIndex}
                                ADBAddr := GetIndADB(info, devTableIndex); { find the device address }
                                if ADBAddr = 2 then
                                    begin {ADBAddr}
                                        device := info.devType;
                                        LightsMagic;
                                    end; {of ADBAddr}
                            end; {devTableIndex}
                    end; {keybaord type 4}
            end; { of noErr}
    end; {of Proc}

    procedure doAbout;
        var
            IDStrHandle: StringHandle;
            dialogP: DialogPtr;
            item: integer;
            Str1, Str2, Str3: str255;
            myHeapSpace: LongInt;
            FreeSpace: Size;
    begin
        IDStrHandle := StringHandle(GetResource(rsrc, 0));
        if IDStrHandle = nil then
            begin
                doMessage('Get About box crash!', '', '', '');
                ExitToShell;
            end;
        MoveHHi(Handle(IDStrHandle));
        HLock(Handle(IDStrHandle));
        FreeSpace := FreeMem;
        myHeapSpace := MaxMem(FreeSpace);
        NumToString(myHeapSpace, Str2);
        Str2 := concat('Memory = ', Str2);
        Str3 := '';
        Str1 := '';
        ParamText(IDStrHandle^^, Str1, Str2, Str3);
        dialogP := GetNewDialog(AboutDialog, nil, pointer(-1));
        if dialogP = nil then
            begin
                doMessage('Dialog crash!', 'We are dead...', '', '');
                ExitToShell;
            end;
        initCursor;
        ModalDialog(nil, item);
        DisposDialog(dialogP);
        HUnlock(Handle(IDStrHandle));
    end;

    procedure doQuit;
    begin
        DisposeWindow(ADBWindow);
        TEDispose(MyTextHandle);
        Finished := true;
    end; {of proc}

    procedure doSave;
    begin
    end;

    procedure doSaveAs;
    begin
    end;

    procedure doPrint;
    begin
    end;

    procedure doPageSet;
    begin
    end;

    procedure doMenubar; {(menuResult : LongInt)}
        var
            theMenu: integer;
            theItem: integer;
            daName: STR255;
            accItem: integer;
            temp: GrafPtr;
            dummy: LongInt;    {Desk Scrap result var}
            ScrapReturn: OSErr; {TEScrap result var}
            TextLength: integer;
            ScrapLength: LongInt;
    begin
        theMenu := HiWord(menuResult); {menu}
        theItem := LoWord(menuResult); {item}
        case theMenu of
            AppleMenu:
                begin
                    if theItem = aAbout then
                        doAbout
                    else
                        begin    {must be DA}
                            GetItem(myMenus[AppleM], theItem, daName);
                            GetPort(temp);    {protect against flacky DA}
                            accItem := OpenDeskAcc(daName);
                            SetPort(temp);
                        end; {else}
                end; {of AppleMenu}
            FileMenu:
                begin
                    case theItem of
                        fADB:
                            begin
                                doADB;
                            end;
                        fSave:
                            begin
                                doSave;
                            end;
                        fSaveAs:
                            begin
                                doSaveAs;
                            end;
                        fPageSet:
                            begin
                                doPageSet;
                            end;
                        fPrint:
                            begin
                                doPrint;
                            end;
                        fQuit:
                            begin
                                doQuit;
                            end;
                        otherwise
                            begin
                            end;
                    end; {of theitem}
                end; {of FileMenu}
            EditMenu:
                begin
                    if not SystemEdit(theitem - 1) then
                        begin
                            case theItem of
                                eUndo:
                                    begin
                                        doMessage('Undo not available.', '', '', '');
                                    end;
                                eCut:
                                    begin
                                        TECut(MyTextHandle);
                                        dummy := ZeroScrap;
                                        ScrapReturn := TEToScrap; {update desk scrap}
                                    end;
                                eCopy:
                                    begin
                                        TECopy(MyTextHandle);
                                        dummy := ZeroScrap;
                                        ScrapReturn := TEToScrap; {update desk scrap}
                                    end;
                                ePaste:
                                    begin
                                        ScrapReturn := TEFromScrap;
                                        TextLength := MyTextHandle^^.teLength;
                                        ScrapLength := TEGetScrapLen;
                                        if (LongInt(TextLength + ScrapLength)) > longInt(TEMax - 1) then
                                            begin
                                                initCursor;
                                                paramText('Paste would exceed text edit 32000 buffer limit!', '', '', '');
                                                ItemHit := StopAlert(AlertDialog, nil);
                                            end
                                        else
                                            TEPaste(MyTextHandle);
                                    end; { of paste}
                                eClear:
                                    begin
                                        TEDelete(MyTextHandle);
                                    end;
                                otherwise
                                    begin
                                    end;
                            end; {of case}
                        end; {of system edit}
                end; {of EditMenu}
            otherwise
                begin
                end;
        end; {of theMenu}
        HiliteMenu(0);    {un-hilite selected menu}
    end;

    procedure doContent; {(ConEvent : EventRecord}
                                    {contentWindow : windowPtr);}
        var
            localPt, globalPt: Point;
            part: integer;
            myRect: Rect;
            control: ControlHandle;
    begin
        if contentWindow <> FrontWindow then
            SelectWindow(contentWindow);
        globalPt := ConEvent.where;
        localPt := globalPt;        {global coord of mouse}
        GlobalToLocal(localPt);     {local coord of mouse}
        part := FindControl(localPt, contentWindow, control);

        if contentWindow = ADBWindow then
            begin
                SetPort(ADBWindow);
                if part <> 0 then
                    begin {in control}
                    end;
                if part = 0 then
                    begin    {content region}
                        myRect := ADBWindow^.portRect;
                        if PtInRect(localPt, myRect) then
                            begin
                                TEClick(localPt, BitAnd(ConEvent.modifiers, ShiftKey) = ShiftKey, myTextHandle)
                            end;  {of ptInRect}
                    end; { of part=0 }
            end; {of contentwindow}
    end;  {of proc}

    procedure doDrag; {(GrabWindow : WindowPtr}
                                {GlobalMouse : point);}
    begin
        DragWindow(GrabWindow, GlobalMouse, DragArea);
    end;

    procedure doGrow; {(ResizeWindow : WindowPtr;}
                                {Globalmouse : point;}
                                {ZoomFlg:Boolean);}
        var
            newSize: LongInt;
            hsize: integer;
            vsize: integer;
            oldPort: GrafPtr;
            myRect: rect;
            tempLong: LongInt;
            l, t, r, b: LongInt;
    begin
        if (ResizeWindow <> FrontWindow) then
            SelectWindow(ResizeWindow)
        else
            begin
                if (ZoomFlg) then
                    begin
                        with ResizeWindow^.portRect do
                            begin
                                tempLong := bottom - top;
                                newSize := BitShift(tempLong, 16);
                                newSize := newSize + (right - left);
                            end;
                    end
                else
                    newSize := GrowWindow(ResizeWindow, Globalmouse, GrowArea);
                if newSize <> 0 then
                    begin  {grow the window}
                        hsize := LoWord(newSize);
                        vsize := HiWord(newSize);
                        if ResizeWindow = ADBWindow then
                            begin
                                with ResizeWindow^.portRect do {Pre-Grow}
                                    begin
                                        SetRect(VCRect, right - (SBarWidth - 1), top - 1, right + 1, bottom - (SBarWidth - 2));
                                        SetRect(HCRect, left - 1, bottom - (SBarWidth - 1), right - (SBarWidth - 2), bottom + 1);
                                        SetRect(GrowRect, HCRect.right, HCRect.top, VCRect.right, HCRect.bottom);
                                    end;  {of with }
                                SizeWindow(ResizeWindow, hsize, vsize, TRUE); {new portRect}
                                InvalRect(GrowRect);
                                EraseRect(GrowRect);
                                with ResizeWindow^.portRect do {Post Grow}
                                    begin
                                        SetRect(VCRect, right - (SBarWidth - 1), top - 1, right + 1, bottom - (SBarWidth - 2));
                                        SetRect(HCRect, left - 1, bottom - (SBarWidth - 1), right - (SBarWidth - 2), bottom + 1);
                                        SetRect(GrowRect, HCRect.right, HCRect.top, VCRect.right, HCRect.bottom);
                                        SetRect(ViewRect, left + 4, top + 4, right - (SBarWidth - 1), bottom - (SBarWidth - 1));
                                    end;  {of with }

                                InvalRect(GrowRect);  {needed for update on shrink}
                                HideControl(VControl);
                                HideControl(HControl);
                                MoveControl(VControl, VCRect.left, VCRect.top);
                                MoveControl(HControl, HCRect.left, HCRect.top);
                                SizeControl(VControl, SBarWidth, VCRect.bottom - VCRect.top);
                                SizeControl(HControl, HCRect.right - HCRect.left, SBarWidth);
                                ShowControl(VControl);
                                ShowControl(HControl);
                                ValidRect(VCRect);
                                ValidRect(HCRect);

                                MyTextHandle^^.ViewRect := ViewRect;
                                InValRect(ViewRect);
                            end; {of if ResizeWindow}
                    end; {of grow window stuff}
            end; {of if then newsize}
    end;  { of proc }

end. {of unit}